;; crspmob3.lsp
;; continues code to implement visualizations for correspondence analysis.
;; Copyright (c) 1992-94 by Lee Bee Leng. Modified May 31, 1995 by FWY
;; Changed by FWY Dec 97 to use new spread-plot function for improved 
;; layout, showing and closing.

(defmeth Corresp-proto :CRS-Fit-Plot ()
  (let*  ((n (send self :maxdim))
          (Singular-Values (second (send self :GSVD)))
          (Inertias (^ Singular-values 2))
          (Chi-Sq (* 1000 (sum (send self :data)) Inertias))
          (Tot-Chi-Sq (sum Chi-sq))
          (Percent-Chi-Sq (* 100 (/ Chi-Sq Tot-Chi-Sq)))
          (CumPercent (* 100 (/ (cumsum Chi-Sq) Tot-Chi-sq)))
          (scree-plot 
           (plot-points (iseq 1 n)
                        inertias ;(^ (second (send self :gsvd)) 2)
                       :show nil
                     ;  :size graph-size
                     ;  :location location22
                       :title "Scree Plot"
                       :variable-labels (list "Dimension" "Inertia"))))
    (setf Fit-Plot scree-plot)
    (send scree-plot :menu nil)
    (send scree-plot :range 0 1 (send self :maxdim))
    (send scree-plot :x-axis t t (send self :maxdim))
    (send scree-plot :y-axis t t 2)
    (send scree-plot :showing-labels t)
    (send scree-plot :mouse-mode 'brushing)
    (send scree-plot :point-state 0 'selected)
    (send scree-plot :adjust-to-data :draw nil)
    (send scree-plot :plot-buttons :new-x nil :new-y nil)
    (send scree-plot :add-lines 
          (list (iseq 1 n) (^ (second (send self :gsvd)) 2)) 
          :draw nil :color 'red)
    (send scree-plot :point-color (iseq n) 'red) 
    (mapcar #'(lambda (i)
                (send scree-plot :point-label i
                      (cond
                        ((> i 0)
                         (format nil "~5,4f, ~5,4f, ~5,4f" 
                                 (select inertias i) 
                                 (select percent-chi-sq i)
                                 (select cumpercent i)))
                        (t
                         (format nil "~5,4f, ~5,4f"
                                 (select inertias i) 
                                 (select percent-chi-sq i))))))
              (iseq (send scree-plot :num-points)))

    (defmeth scree-plot :plot-help ()
      (plot-help-window (strcat "Help for " (send self :title)))
      (paste-plot-help (format nil "The Scree plot shows the relative fit (importance) of each dimension. For Correspondence Analysis it does this by plotting the Inertia for each dimension versus the dimension's number. The Inertias are the squared Singular Values, which are a measure of variance in the data accounted for by the model. Thus, the plot shows the relative importance of each dimension in fitting the data.~2%"))
(paste-plot-help (format nil "The Scree plot can be used to aid in the decision about how many dimensions are useful. You use it to make this decision by looking for an elbow (bend) in the curve. If there is one (and there often isn't) then the dimensions following the bend account for relatively little additional inertia, and can perhaps be ignored.~2%"))
      (paste-plot-help (format nil "The numbers beside the points provide detailed numeric information about the fit of each dimension. The first number is the Inertia for the dimension. The second number is the percentage that the dimension contributes to the total inertia (the percentage of fit due to the dimension). For the higher dimensions, the third number is the cummulated percentage of inertia accounted for by the dimension and the preceeding dimensions.~2%"))
      (paste-plot-help (format nil "The plot shows the numeric details for the first dimension. You may move your cursor across other points in the plot for details about other dimensionalities. You should make sure that a sufficient proportion of the data's inertia is accounted for, but that the dimensionality is not too high.~2%"))
      
      (show-plot-help))
    scree-plot))
 
 
(defmeth Corresp-proto :CRS-Dimension-List (my-data)
  (setf Dimension-list (name-list
                         (mapcar #'(lambda (x) (format nil "Dimension ~a" x))
                                 (+ (iseq (send self :maxdim)) 1))
                         :show nil
                       ;  :size (list (- (first graph-size) msdos-fiddle)
                       ;              (second graph-size))
                       ;  :location location23
                         :title "Dimensions"))
   ; (send Dimension-list :selection (iseq (send current-model :dimension)))
    (send Dimension-list :cursor 'finger)
    (send Dimension-list :menu nil)
    (send Dimension-list :fix-name-list)
    ;(send Dimension-list :has-h-scroll (max (screen-size)))
    ;(send Dimension-list :has-v-scroll (max (screen-size)))
    
    (defmeth Dimension-list :do-select-click (x y m1 m2)
      (call-next-method x y m1 m2)
      (let* ((Current-Vars (send self :selection))
             (Dim (length Current-Vars))
             (deviations (combine (send current-model :deviation)))
             (stdev-dev (standard-deviation deviations))
          ;  (mean-dev (mean deviations))
             (residuals nil)
          ;  (mean-res (mean residuals))
          ;  (stdev-res (standard-deviation residuals))
             )
        (when (= Dim 0)
              (send self :plot-deviations)
              (send corresp-mp :start-buffering)
              (send corresp-mp :new-plot 
                       (send my-data :active-data '(numeric)) 
                       (list (send my-data :nobs)
                             (send my-data :active-nvar '(numeric)) 
                             ) 
                       :shading deviations
                       :standardize-shading t
                       :to-label '(0 1)
                       :way-labels (send my-data :freq-way-names) 
                       :gaps '(20 20))
              (send corresp-mp :buffer-to-screen))
        (when (> Dim 0)
              (cond
                ((not (send current-model :Point-Moved-p))
                 (send self :Recompute-and-Replot-Residuals Current-Vars)
                 (setf residuals (combine (send current-model :residuals)))
             ;   (setf mean-res (mean residuals))
                 (send corresp-mp :start-buffering)
                 (send corresp-mp :new-plot 
                       (send my-data :active-data '(numeric)) 
                       (list (send my-data :nobs)
                             (send my-data :active-nvar '(numeric)) 
                             ) 
                       :shading (/ residuals stdev-dev) 
                              ; (- residuals mean-res) stdev-dev)
                       :standardize-shading nil
                       :to-label '(0 1)
                       :way-labels (send my-data :freq-way-names) 
                       :gaps '(20 20))
                 (send corresp-mp :buffer-to-screen)
                 )
                (t
                  (send Scatterplot :Reset-Residuals))))
        (when (> Dim 1)
              (send Scatterplot :current-variables
                    (first Current-Vars)
                    (second Current-Vars)))
        (when (> Dim 2)
              (send spinplot :transformation nil)
              (send Spinplot :current-variables
                    (first Current-Vars)
                    (second Current-Vars)
                    (third Current-Vars))
              (send Spinplot :variable-label (iseq (send self :num-points))
                    (send Dimension-list :set-spinplot-labels))
              (send spinplot :add-box)
              (send Spinplot :redraw t))))

  (defmeth Dimension-list :plot-help ()
    (plot-help-window (strcat "Help for " (send self :title)))
    (paste-plot-help (format nil "The DIMENSIONS window presents a list of the dimension names. This window is linked to other windows. By clicking, shift-clicking or draging on one or more dimensions you will change the information shown in the other plots.~2%"))
    (show-plot-help))
    
    (defmeth Dimension-list :set-spinplot-labels ()
      (let* ((dummy (repeat "" (send self :num-points)))
             (selected-axes (select (send self :selection) (iseq 3))))
        (setf (select dummy selected-axes)
              (mapcar #'(lambda (x) (format nil "Dim~a" x))
                      (+ 1 selected-axes)))
        dummy))

    (defmeth dimension-list :plot-deviations ()
      (let* ((n-pts (send residual-plot :num-points))
             (pt-st (send residual-plot :point-state (iseq n-pts))))
        (send Residual-plot :clear-points :draw nil)
        (send Residual-plot :add-points
              (combine (row-list (send current-model :deviation)))
              (combine (row-list (send current-model :deviation)))
              :draw nil)
        (send Residual-plot :point-color 
              (iseq (send Residual-plot :num-points)) 'green)
        (send Residual-plot :point-symbol 
              (iseq (send Residual-plot :num-points)) 'square)
        (send Residual-plot :adjust-to-data)
        (send Residual-plot :x-axis t t 2)
        (send Residual-plot :y-axis t t 2)
        (send residual-plot :point-state (iseq n-pts) pt-st)))
    
    (defmeth Dimension-list :Recompute-and-Replot-Residuals (dims)
      (let* ((gsvd (send current-model :gsvd))
             (Ar (apply #'bind-columns
                        (select (column-list (first gsvd)) dims)))
             (Dr (diagonal (select (second gsvd) dims)))
             (Br (apply #'bind-columns
                        (select (column-list (third gsvd)) dims)))
             (fitted (%* Ar Dr (transpose Br)))
             (resid (- (send current-model :Deviation) fitted))
             (n-pts (send residual-plot :num-points))
             (pt-st (send residual-plot :point-state (iseq n-pts)))
             )
        (if (= (length (send self :selection))
               (send current-model :maxdim))
            (send current-model :Residuals
                  (make-array (list (send current-model :Nrows)
                                    (send current-model :Ncols))
                              :initial-element 0))
            (send current-model :Residuals resid))
        (send Residual-plot :clear-points :draw nil)
        (send Residual-plot :add-points
              (combine (row-list (send current-model :deviation)))
              ;(combine (row-list (send current-model :expected)))
              (combine (row-list (send current-model :residuals))) :draw nil)
        (send Residual-plot :point-color 
              (iseq (send Residual-plot :num-points)) 'green)
        (send Residual-plot :point-symbol 
              (iseq (send Residual-plot :num-points)) 'square)
        (send Residual-plot :adjust-to-data)
        (send Residual-plot :x-axis t t 2)
        (send Residual-plot :y-axis t t 2)
        (send residual-plot :point-state (iseq n-pts) pt-st)))
    
   ; #-msdos(send Dimension-list :size (- (select namelist-size 0) msdos-fiddle)
   ;              (- (select namelist-size 1) msdos-fiddle))
   ; #+msdos(send Dimension-list :size (- (select namelist-size 0) msdos-fiddle)
   ;              (- (select namelist-size 1) msdos-fiddle))
     dimension-list)
  
  
(defmeth Corresp-proto :visualize ()
  (if (not (eq current-object self)) (setcm self))
  (send current-model :compute-residuals) 
  (let* ((my-data (send self :data-object))
         (freq-way-names (send my-data :freq-way-names)) 
         (row-name (if (first freq-way-names)
                       (first freq-way-names)
                       "Rows"))
         (col-name (if (second freq-way-names)
                       (second freq-way-names)
                       "Columns"))
         (freq-way-names (list row-name col-name))
         (level-labels (list (send self :labels) 
                             (send self :active-variables'(numeric))))
         (deviations (combine (send current-model :deviation)));residuals
         (mean-dev (mean deviations))
         (std-dev (standard-deviation deviations))
         (mp (mosaic-plot (send my-data :active-data '(numeric)) 
                          (list (send my-data :nobs)
                                (send my-data :active-nvar '(numeric)) 
                                ) 
                          :freq t 
                          :connect-button t
                          :color-values deviations
                          :way-labels freq-way-names 
                          :level-labels level-labels
                          :show nil))
         (sp (spread-plot 
              (matrix '(2 3) 
                      (list (send current-model :CRS-Spin-plot)
                            mp
                            (send current-model :CRS-Name-List)
                            (send current-model :CRS-Residual-Plot)
                            (send current-model :CRS-Fit-Plot)
                            (send current-model :CRS-Dimension-List my-data)))))
         (spin (aref (send sp :plot-matrix) 0 0))
         (nv (send spin :num-variables))
         )
    (send spin :scale (iseq nv) (/ (send spin :scale (iseq nv)) 2))
    (setf corresp-mp mp)
    (send mp :plot-buttons :margin '(0 20 0 0) :new-x nil :new-y nil :mouse-mode nil)
    (send current-model :CRS-Scatter-plot)
    (send sp :show-spreadplot)
    
    (defmeth sp :spreadplot-help ()
      (plot-help-window (strcat "SpreadPlot Help"))
      (paste-plot-help (format nil "This is the SpreadPlot for Correspondence Analysis. In this SpreadPlot the windows are linked by the data's observations and variables, and by the model's dimensions. "))

(if (/= (send current-model :norm-opt) 2)
    (paste-plot-help (format nil "They are also linked via the equations of the Correspondence Analysis model.")))

(paste-plot-help (format nil "~2%The Dimensions window, which is in the lower right corner, lets you choose which Dimensions are displayed in other windows. "))
    (paste-plot-help (format nil "You can select a single Dimension by clicking on a Dimension name, or you can select several Dimensions by draging or shift-clicking on several names. Selecting Dimensions causes new information about the analysis to be displayed in the other windows.~2%"))
      (paste-plot-help (format nil "The Rows and Columns window, at the upper right, presents labels for both observations (rows) and variables (columns). Selecting labels will cause points in the other plots to be highlighted.~2%"))
      (if (/= (send current-model :norm-opt) 2)
          (paste-plot-help (format nil "The windows are also linked algebraically through the Point Moving mouse mode of the Scatterplot window. When the mouse is in this mode, points in one of the sets of points can be moved to new locations. When a point is moved, the model recalculates itself and presents the new results graphically.~2%")))
          
      (show-plot-help)
      (call-next-method :skip t :flush nil))

    t))
 
;---------------------------------------------------------------
;  Supporting Functions
;---------------------------------------------------------------
 
(defun locate-residual (x nr nc)
  (let* ((x (+ x 1)))
    (if (> (mod1 x nc) 0)
        (let* ((row (+ (div x nc) 1))
               (col (+ nr (- x (* (- row 1) nc)))))
          (list (- row 1) (- col 1)))
        (let* ((row (div x nc))
               (col (+ nr nc)))
          (list (- row 1) (- col 1))))))
 
(defun identify-residual (x nr nc)
  (+ (* (first x) nc) (- (second x) nr)))
 
(defun div (x a) 
  (floor (/ x a)))
 
;fwy 1/16/98 modified from mod to mod1 to not destroy definition of mod.
(defun mod1 (x a)
  (- (/ x a) (div x a)))
 
(defun Get-GSVD (gsvd nr nc)
  (let* ((q (length (second gsvd)))
         (A (select (first gsvd) (iseq nr) (iseq 1 (- q 1))))
         (Du (diagonal (select (second gsvd) (iseq 1 (- q 1)))))
         (B (select (third gsvd) (iseq nc) (iseq 1 (- q 1)))))
    (list A (diagonal Du) B (fourth gsvd))))
 


(defmeth Corresp-proto :interpret-model ()
 
(let* ((w (send edit-window-proto :new :title "CRS Model Interpretation")))

(send w :paste-string "The scree plot provides a graphical representation of the importance of each of the underlying dimensions (factors) explaining the data.  If there is a steep decline in the scree plot, the number of salient dimensions may be the number just before the decline.  If there is no steep decline in the scree plot, the appropriate number of dimensions may be decided by the amount of variance accounted for by each dimension, as shown in the ViSta Report. Generally, factors are taken into account up to explain 75% or 80% of the cumulative variance.
The distance between the row points is a measure of similarity between the row-frequency profiles - raw-points are far from each other because their profiles are different, whereas raw-points are close together because their profiles are similar. Distances between the points representing variables are interpreted in the same way.
The contingency table is the table of relative frequencies, scaled to percentages. 
The row and column profiles are the row and column frequencies, scaled to percentages.
Chi-Square statistics are defined for each cell of the table as the observed frequency minus the expected frequency under the hypothesis of row and column independence. 
The row and column coordinates are for the first k dimensions, where k is the dimensionality specified under the analysis options.
Sometimes
The inertias are the partial contribution to principal inertias for row points and column points. 
Each column of the partial contribution to inertia for Row Points in the report represents one factor (dimension). The vertical total of the column is 1, a factor is made at 100% by the different lines (either variable or observations). Take into account the variables and observations that have more inertia than the average row inertia or variable inertia. The inertias show how each factor is explained by each variable or observation.  
The squared cosines for row points and column points show how each variable or observation is explained by each factor. The horizontalal total of each ligne is 1, a variable or observation  is explained at 100% by the different factors. Take into account the variables and observations that have more than 0.50 square cosines (corresponding to a correlation coefficient of about 0.7).
Sometimes, the spreadplot has the shape of a V (with the arms of the V more or less widely open), this is called the Guttman effect, it means that in the data, a general trend to increase is observed up to a point and then a decrease is observed.

The summary statistics are summaries for row points and column points including the quality of representation of points in the k-dimensional display, the masses, inertias, and the points that contribute most to inertia.")))
;;                       -- End of Part III --
 
